#!/usr/bin/perl

use XML::Parser;

our $l = 0;
our @tag;
our $tag, $attr, $val, $data;
our $name;
our %package;

binmode STDIN, ':utf8';
binmode STDOUT, ':utf8';

## use YAML;
## $YAML::Indent = 2;
## $YAML::UseHeader = 0;
## $YAML::UseVersion = 0;


# YAML coder routines based on YAML module.

# Check whether or not a scalar should be emitted as an plain scalar.
sub is_valid_plain {
    return 0 unless length $_[0];
    # refer to YAML::Loader::parse_inline_simple()
    return 0 if $_[0] =~ /^[\s\{\[\~\`\'\"\!\@\#\>\|\%\&\?\*\^]/;
    return 0 if $_[0] =~ /[\{\[\]\},]/;
    return 0 if $_[0] =~ /[:\-\?]\s/;
    return 0 if $_[0] =~ /\s#/;
    return 0 if $_[0] =~ /\:(\s|$)/;
    return 0 if $_[0] =~ /[\s\|\>]$/;
    return 1;
}

# Escapes for unprintable characters
my @escapes = qw(\z   \x01 \x02 \x03 \x04 \x05 \x06 \a
                 \x08 \t   \n   \v   \f   \r   \x0e \x0f
                 \x10 \x11 \x12 \x13 \x14 \x15 \x16 \x17
                 \x18 \x19 \x1a \e   \x1c \x1d \x1e \x1f
                );

# Escape the unprintable characters
sub escape {
    my ($text) = @_;
    $text =~ s/\\/\\\\/g;
    $text =~ s/([\x00-\x1f])/$escapes[ord($1)]/ge;
    return $text;
}

# Emit escape if is necessary
sub emit_string {
    my ($text) = @_;
    return $text if is_valid_plain $text;
    (my $escaped = escape($text)) =~ s/"/\\"/g;
    return qq{"$escaped"};
}


my $p = new XML::Parser;
$p->setHandlers(
    Start => sub {
	shift;
	$tag = shift;
	push @tag, $tag;
	$data = "";
	die if ($l == 0 && $tag !~ /^REPOSITORYSUMMARY$/i);
	if ($l == 1) {
	    die if ($tag !~ /^SOFTPKG$/i);
	    ($NAME, $VERSION) = undef;
	    while ($attr = shift) {
		$val = shift;
		if ($attr =~ /^NAME$/i) {
		    $NAME = $val;
		}
		elsif ($attr =~ /^VERSION$/i) {
		    $VERSION = $val;
		}
	    }
	    $name = $NAME;
	    %package = ();
	    $package{version} = $VERSION if defined $VERSION;
	}
	elsif ($l == 2 && $tag =~ /^PROVIDE$/i) {
	    ($NAME, $VERSION) = undef;
	    while ($attr = shift) {
		$val = shift;
		if ($attr =~ /^NAME$/i) {
		    $NAME = $val;
		}
		elsif ($attr =~ /^VERSION$/i) {
		    $VERSION = $val;
		}
	    }
	    $package{provide}{$NAME} = $VERSION;
	}
	elsif ($l == 2 && $tag =~ /^REQUIRE$/i) {
	    ($NAME, $VERSION) = undef;
	    while ($attr = shift) {
		$val = shift;
		if ($attr =~ /^NAME$/i) {
		    $NAME = $val;
		}
		elsif ($attr =~ /^VERSION$/i) {
		    $VERSION = $val;
		}
	    }
	    $package{require}{$NAME} = $VERSION;
	}
	elsif ($l == 3 && $tag[2] =~ /^IMPLEMENTATION$/i) {
	    if ($tag =~ /^ARCHITECTURE$/i) {
		$NAME = undef;
		while ($attr = shift) {
		    $val = shift;
		    if ($attr =~ /^NAME$/i) {
			$NAME = $val;
		    }
		}
		$package{architecture} = $NAME if defined $NAME;
	    }
	    elsif ($tag =~ /^CODEBASE$/i) {
		$HREF = undef;
		while ($attr = shift) {
		    $val = shift;
		    if ($attr =~ /^HREF$/i) {
			$HREF = $val;
		    }
		}
		$package{codebase} = $HREF if defined $HREF;
	    }
	}
	$l++;
    },
    End => sub {
	shift;
	if ($l == 2) {
	    printf "%s:\n", $name;
	    printf "  abstract: %s\n", emit_string($package{abstract}) if defined $package{abstract};
	    printf "  architecture: %s\n", emit_string($package{architecture}) if defined $package{architecture};
	    printf "  author: %s\n", emit_string($package{author}) if defined $package{author};
	    printf "  codebase: %s\n", emit_string($package{codebase}) if defined $package{codebase};
	    printf "  version: %s\n", emit_string($package{version}) if defined $package{version};
	    if (defined $package{require}) {
		printf "  require:\n";
		foreach (sort keys %{$package{require}}) {
		    printf "    %s: %s\n", emit_string($_), emit_string($package{require}{$_});
		}
	    }
	    if (defined $package{provide}) {
		printf "  provide:\n";
		foreach (sort keys %{$package{provide}}) {
		    printf "    %s: %s\n", emit_string($_), emit_string($package{provide}{$_});
		}
	    }
	    ## print Dump { $name => \%package };
	}
	elsif ($l == 3) {
	    if ($tag =~ /^ABSTRACT$/i) {
		$package{abstract} = $data if $data;
	    }
	    elsif ($tag =~ /^AUTHOR$/i) {
		$package{author} = $data if $data;
	    }
	}
	($tag, $attr, $val) = undef;
	pop @tag;
	$l--;
    },
    Char => sub {
	shift;
	$data .= shift;
    },
);

$p->parsefile($ARGV[0]);
